home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 3_2004-2005.ISO / Data / Zips / DNS_Browse18346512302004.psc / December 11 / clsAlpha.cls < prev    next >
Text File  |  2004-11-27  |  3KB  |  109 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "clsAlpha"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
  15. Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
  16. Option Explicit
  17.  
  18. ' =====================================================
  19. ' Private API Declarations
  20. ' =====================================================
  21.  
  22. Private Declare Function SetWindowLong Lib "user32" _
  23.     Alias "SetWindowLongA" _
  24.     (ByVal hwnd As Long, _
  25.     ByVal nIndex As Long, _
  26.     ByVal dwNewLong As Long) As Long
  27.  
  28. Private Declare Function GetWindowLong Lib "user32" _
  29.     Alias "GetWindowLongA" _
  30.     (ByVal hwnd As Long, _
  31.     ByVal nIndex As Long) As Long
  32.  
  33. Private Declare Function RedrawWindow Lib "user32" _
  34.     (ByVal hwnd As Long, _
  35.     lprcUpdate As RECT, _
  36.     ByVal hrgnUpdate As Long, _
  37.     ByVal fuRedraw As Long) As Long
  38.  
  39. Private Declare Function SetLayeredWindowAttributes Lib "user32" _
  40.     (ByVal hwnd As Long, _
  41.     ByVal crKey As Long, _
  42.     ByVal bAlpha As Byte, _
  43.     ByVal dwFlags As Long) As Long
  44.  
  45. ' ===========================================
  46. ' Private Type UDTs for API
  47. ' ===========================================
  48.  
  49. Private Type RECT
  50.         Left As Long
  51.         Top As Long
  52.         Right As Long
  53.         Bottom As Long
  54. End Type
  55.  
  56. ' ===========================================
  57. ' Private Constants
  58. ' ===========================================
  59.  
  60. Private Const WS_EX_LAYERED = &H80000
  61. Private Const GWL_EXSTYLE = (-20)
  62. Private Const LWA_ALPHA = &H2
  63.  
  64. ' Redraw window constants
  65. Private Const RDW_ALLCHILDREN = &H80
  66. Private Const RDW_ERASE = &H4
  67. Private Const RDW_FRAME = &H400
  68. Private Const RDW_INVALIDATE = &H1
  69.  
  70. ' ========================================
  71. ' Public Module Level Vars
  72. ' ========================================
  73.  
  74. Friend Sub SetLayered(ByVal hwnd As Long, ByVal bolSetAs As Boolean, ByVal bAlpha As Byte)
  75.     ' Toggle layered and set the alpha chanel
  76.     
  77.     Dim nullRect As RECT
  78.     Dim lret As Long
  79.     
  80.     ' ===================================================
  81.     ' Update here with window names
  82.     ' ===================================================
  83.     
  84.     lret = GetWindowLong(hwnd, GWL_EXSTYLE)
  85.  
  86.     If bolSetAs = True Then
  87.         lret = lret Or WS_EX_LAYERED
  88.     Else
  89.         lret = lret And Not WS_EX_LAYERED
  90.     End If
  91.     
  92.     SetWindowLong hwnd, GWL_EXSTYLE, lret
  93.     
  94.     If bolSetAs Then
  95.         SetLayeredWindowAttributes hwnd, 0, bAlpha, LWA_ALPHA
  96.     Else
  97.         RedrawWindow hwnd, nullRect, 0&, RDW_ALLCHILDREN Or RDW_ERASE Or RDW_FRAME Or RDW_INVALIDATE
  98.     End If
  99. End Sub
  100.  
  101. Friend Sub ReleaseDisplay(ByVal hwnd As Long)
  102.     ' Release this layered window display
  103.     SetLayered hwnd, False, 255
  104. End Sub
  105.  
  106.  
  107.  
  108.  
  109.